perm filename MPRNT.F4[Y,MUS] blob
sn#068326 filedate 1973-12-01 generic text, type T, neo UTF8
00100 C MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200 C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00250 C LOAD WITH PPSRT, PLTCMD, NOTWRT, ITMSBX, TREST, CLFZ, LOOK
00300
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600 COMMON /DL/IXRX,SAVER,NAME
00700 DIMENSION V(78),LIST(200)
00800 COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
01000 COMMON/ALF/INP(3),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100 COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300 COMMON/DPY/GO,RXGP,TOP,BOT
01400 EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500 1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JF,JQ(4)),(RJG,RJQ(5))
01600 1,(RJD,RJQ(2)),(RJC,RJQ(1)),(I1,INP(1)),(V,RN(3000))
01700 1,(LIST,RN(3100))
02100 DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02500 1 ,IP/'P'/
02700
02800 TOP2=-999
02900 RXGP=0
03000 I1=0
03100 C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
03600 2 PLOTIT=0
03700 RSZ=.845
03800 TOP=-999
03900 BOT=999
04200 PLT=0
04300 PWDS(1)=1.
04400 EDX=-1
04600 DO 1402 K=1,8
04700 1402 RSTFAC(K)=1.
04900 M=1
05000 ITEM=0
05100 IXRX=0
05400 I=1
06900 58 GO=-1
07000 GO TO 5504
07100
07200
07300 11 CALL NOTWRT
07400 57 IF(PLT)GO TO 6120
07700 ITEM=ITEM+1
08400 IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
08500 IF(PLOTIT.EQ.-2)GO TO 2311
08700 PWDS(ITEM+1)=I
08800 PLT=0
09100 GO=-1
09200
12400 5504 IF(I1.EQ.IP)GO TO 2311
12500 59 TYPE 56
12800 ACCEPT 89,INP
18800 311 JA=0
19200 IF(I1.NE.IP)GO TO 85
19500 2311 CALL PLTCMD
19600 IF(PLOTIT.EQ.0)GO TO 3005
19700 I1=IP
19800 PLOTIT=-1
20000 C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
20600 89 FORMAT(72A1)
20800
27800 6531 M=1
27900 EDX=-1
28200 DO 5532 K=1,9
28300 5532 JQ(K)=RJQ(K)
29700 590 IF(PLOTIT.EQ.-1)GO TO 121
29800 I1=0
29900 243 RJB=1.
29910 C TO RUN THROUGH DATA.
29920 241 RSZ=.845*RJB
29950 RJB=0
29960 RJC=0
29970 RJD=0
29980 TOP=-999
29990 BOT=999
30000 C GOES TO PLOTTER
33000 85 M=1
33100 I=PWDS(ITEM+1)
33200 ITEM=0
33400 8852 PLT=1
33500 EDX=0
33700 GO=0
33800 GO TO 6120
33900
51900 60 RSTJC=RSTFAC(JC+4)
55200 5541 POS=STFF(JC+4)
55300 JB=RHORZ(RJB)
55400 C LINE IS DIVIDED INTO 200 POINTS.
55500 CENTR=POS
55600 551 IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
55700 IF(JA.EQ.7)GO TO 81
55800 IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
55900 IF(JA.EQ.18)GO TO 80
56500 CALL ALPHA
56600 GO TO 57
56700
56800 81 CALL KSIG
56900 GO TO 57
57000
57100 80 CALL METER
57200 GO TO 57
57300
57700 25 CALL ITMSUB
57800 C BAR LINES, BEAMS, STAFF LINES ****
57900 GO TO 57
58000
58900 3005 REWIND 21
59000 C GUARDS AGAINST LOSSAGE!
59200 PLOTIT=-2
59400 CALL IFILE(21,NAME)
59500 C JUMP TO READ BIG FILES
59600 2200 J=ITEM+1
59700 2202 READ(21),X,Y,
59800 1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
59814 1 LCNT,(LIST(K),K=1,LCNT)
59884 READ(21),RSTFAC,STFF
59900 ITEM=ITEM+X
60000 I=Y
60600 GO TO 6531
61700 121 IF(PLOTIT.EQ.0)GO TO 5504
61800 5121 CALL PLTSRT
61900 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
62000 PLT=-1-JH
62100 C (JH) P8=1 OR 2 FOR 2-PASS PLOTS
62200 M=I
62300 I=I+M-1
62400 IF(RJB.EQ.0)RJB=1.
62500 DIS=RJB*1.24
62600 IF(RJC.EQ.0)RJC=RJB
62700 RHT=RJC*1.2
62800 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
62900 BOT=-BOT*RHT
63000 IF(TOP2.EQ.-999)GO TO 8121
63100 BOT=BOT+TOP2
63200 GO TO 9121
63300 8121 CALL PLOTS(K)
63400 RXGP=995.-BOT
63500 9121 NOMOVE=RJF+RJG*148.*RJC
63600 C RJF=1 FOR NO MOVE AT END. RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
63700 IXGP=JD
63800 C (JD) P4=1 FOR XGP OUTPUT
63900 IF(JE.NE.0)GO TO 1122
64000 IF(RJD.EQ.0)GO TO 6121
64100 IF(TOP2.NE.-999)RXGP=RXGP-BOT
64200 C MOVES 0 POINT OVER EACH TIME.
64300 GO TO 1122
64400 6121 CALL PLOT(0,BOT,-3)
64500 C MOVES PLOTTER UP IF P5=0.
64600 1122 IXRX=IXGP
64700
64800 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
64900 6120 IF(M.GE.I)GO TO 7120
65000 CNT=RN(M)
65200 DO 6220 K=CNT+1,10
65300 JQ(K)=0
65400 6220 RJQ(K)=0
65500 JA=RN(M+1)
65600 M=M+2
65700 RJB=RN(M)
65800 DO 9120 K=1,CNT
65900 RJQ(K)=RN(M+K)
66000 9120 JQ(K)=RJQ(K)
66100 M=CNT+M+1
66200 IF(EDX.LE.0)GO TO 60
66300 GO TO 5504
66400
66500 7120 M=1
66600 IF(EDX)GO TO 71201
66700 IF(PLT.EQ.1)EDX=-1
66800 PLT=0
66900 C RETURNS FOR 'SL'=SAVE LAST
67000 GO TO 5504
67100 71201 X=50*RHT
67200 TOP=TOP*RHT+X
67300 IF(NOMOVE.NE.0)TOP=0
67400 IF(NOMOVE.GT.1)TOP=NOMOVE
67500 IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
67600 TOP2=TOP
67700 GO TO 2
67800 C TO MOVE 'PLOTTER' FOR XGP OUTPUT
68000 C MOVES PLOTTER UP
68100 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
68400
68500 56 FORMAT(' PXG OR PXC'/)
68800 END